home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Grab Bag
/
Shareware Grab Bag.iso
/
001
/
pibt3sp4.arc
/
SETPARMC.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1985-10-07
|
43KB
|
1,135 lines
(*----------------------------------------------------------------------*)
(* Read_Config_File --- Read configuration file *)
(*----------------------------------------------------------------------*)
OVERLAY FUNCTION Read_Config_File : BOOLEAN;
(*----------------------------------------------------------------------*)
(* *)
(* Function: Read_Config_File *)
(* *)
(* Purpose: Reads parameters from primary PibTerm config. file *)
(* *)
(* Calling Sequence: *)
(* *)
(* Read_Ok := Read_Config_File : BOOLEAN; *)
(* *)
(* Read_Ok --- TRUE if config file found, else FALSE. *)
(* *)
(* Calls: Get_Config_File_Line *)
(* *)
(*----------------------------------------------------------------------*)
VAR
Ival : INTEGER;
OK_To_Read : BOOLEAN;
I : INTEGER;
J : INTEGER;
Param_Num : INTEGER;
Param_Str : AnyStr;
Param_Ival : INTEGER;
Param_Rval : REAL;
(*--------------------------------------------------------------------------*)
(* Get_Config_File_Line --- Get one parameter line from config file *)
(*--------------------------------------------------------------------------*)
FUNCTION Get_Config_File_Line( VAR Param_Num: INTEGER;
VAR Param_Str: AnyStr;
VAR Param_Ival: INTEGER;
VAR Param_Rval: REAL ) : BOOLEAN;
(*--------------------------------------------------------------------------*)
(* *)
(* Function: Get_Config_File_Line *)
(* *)
(* Purpose: Reads and interprets one line of configuration file *)
(* *)
(* Calling Sequence: *)
(* *)
(* QGot := Get_Config_File_Line( VAR Param_Num: INTEGER; *)
(* VAR Param_Str: AnyStr; *)
(* VAR Param_Ival: INTEGER; *)
(* VAR Param_Rval: REAL ) : BOOLEAN; *)
(* *)
(* Param_Num --- parameter number of this line *)
(* Param_Str --- string value of parameter *)
(* Param_Ival --- Integer value of parameter *)
(* Param_Rval --- Real value of parameter *)
(* *)
(* Qgot --- TRUE if configuration line returned; *)
(* FALSE if end-of-file encountered on *)
(* configuration file. *)
(* *)
(* Calls: None *)
(* *)
(*--------------------------------------------------------------------------*)
VAR
I: INTEGER;
S: AnyStr;
PName: STRING[2];
BEGIN (* Get_Config_File_Line *)
(* Initialize parameter values *)
Param_Num := 0;
Param_Str := '';
Param_Ival := 0;
Param_Rval := 0;
IF NOT EOF( Config_File ) THEN
BEGIN
Get_Config_File_Line := TRUE;
(* Indicate line from configuration file *)
READLN( Config_File , S );
S := S + ' ';
I := 0;
PName := UpCase( S[1] ) + UpCase( S[2] );
Param_Str := Trim( COPY( S, 4, LENGTH( S ) - 3 ) );
(* Search for parameter *)
REPEAT
I := I + 1;
UNTIL ( I > Max_Param_Names ) OR ( PName = Param_Names[I] );
(* If found, convert to numeric if *)
(* appropriate *)
IF I <= Max_Param_Names THEN
BEGIN
Param_Num := I;
FOR I := 1 TO LENGTH( Param_Str ) DO
IF Param_Str[I] IN ['0'..'9'] THEN
Param_Ival := Param_Ival * 10 + ORD( Param_Str[I] ) -
ORD( '0' );
IF LENGTH( Param_Str ) > 0 THEN
IF ( UpCase(Param_Str[1]) = 'Y' ) THEN
Param_Ival := 1;
Param_Rval := Param_Ival;
END;
END
ELSE
Get_Config_File_Line := FALSE;
END (* Get_Config_File_Line *);
(*--------------------------------------------------------------------------*)
BEGIN (* Read_Config_File *)
(* Assign configuration file *)
ASSIGN( Config_File , Home_Dir + 'PIBTERM.CNF' );
(*$I-*)
RESET( Config_File );
(*$I+*)
OK_To_Read := ( Int24Result = 0 );
IF NOT OK_To_Read THEN (* If config file missing, prompt *)
(* user for input *)
BEGIN (* No configuration file *)
WRITELN;
WRITELN('Can''t find configuration file PIBTERM.CNF');
END (* No configuration file *)
ELSE (* PIBTERM.CNF exists -- read it *)
BEGIN (* Config file exists *)
WRITELN('Reading configuration file PIBTERM.CNF');
WHILE( Get_Config_File_Line( Param_Num, Param_Str, Param_Ival,
Param_Rval ) ) DO
Set_Parameter( Param_Num, Param_Ival, Param_Rval, Param_Str );
CLOSE( Config_File );
END (* Config file exists *);
Read_Config_File := OK_To_Read;
END (* Read_Config_File *);
(*--------------------------------------------------------------------------*)
(* Read_Config_From_Script --- Read parameters from script buffer *)
(*--------------------------------------------------------------------------*)
OVERLAY PROCEDURE Read_Config_From_Script;
(*----------------------------------------------------------------------*)
(* *)
(* Function: Read_Config_From_Script *)
(* *)
(* Purpose: Reads parameters from PibTerm script buffer *)
(* *)
(* Calling Sequence: *)
(* *)
(* Read_Config_From_Script; *)
(* *)
(* Calls: Get_Config_File_Line_From_Script *)
(* *)
(*----------------------------------------------------------------------*)
VAR
Ival : INTEGER;
OK_To_Read : BOOLEAN;
I : INTEGER;
J : INTEGER;
Param_Num : INTEGER;
Param_Str : AnyStr;
Param_Ival : INTEGER;
Param_Rval : REAL;
(*--------------------------------------------------------------------------*)
(* Get_Config_File_Line_From_Script --- Get one param. line from script *)
(*--------------------------------------------------------------------------*)
FUNCTION Get_Config_File_Line_From_Script( VAR Param_Num: INTEGER;
VAR Param_Str: AnyStr;
VAR Param_Ival: INTEGER;
VAR Param_Rval: REAL ) : BOOLEAN;
(*--------------------------------------------------------------------------*)
(* *)
(* Function: Get_Config_File_Line_From_Script *)
(* *)
(* Purpose: Reads and interprets one line of script buffer *)
(* *)
(* Calling Sequence: *)
(* *)
(* QGot := Get_Config_File_Line_From_Script( VAR Param_Num: INTEGER; *)
(* VAR Param_Str: AnyStr; *)
(* VAR Param_Ival: INTEGER;*)
(* VAR Param_Rval: REAL ) *)
(* : BOOLEAN; *)
(* *)
(* Param_Num --- parameter number of this line *)
(* Param_Str --- string value of parameter *)
(* Param_Ival --- Integer value of parameter *)
(* Param_Rval --- Real value of parameter *)
(* *)
(* Qgot --- TRUE if configuration line returned; *)
(* FALSE if end-of-buffer encountered on *)
(* script buffer. *)
(* *)
(* Calls: None *)
(* *)
(*--------------------------------------------------------------------------*)
VAR
I: INTEGER;
J: INTEGER;
L: INTEGER;
PName: STRING[2];
BEGIN (* Get_Config_File_Line_From_Script *)
(* Initialize parameter values *)
Param_Num := 0;
Param_Str := '';
Param_Ival := 0;
Param_Rval := 0;
(* Move to next slot in script *)
Script_Buffer_Pos := Script_Buffer_Pos + 1;
(* See if it's PARAM *)
IF ( PibTerm_Command_Table_2[ Script_Buffer^[Script_Buffer_Pos] ]
= ParamSy ) THEN
BEGIN
Get_Config_File_Line_From_Script := TRUE;
Script_Buffer_Pos := Script_Buffer_Pos + 1;
J := Script_Buffer_Pos;
PName := UpCase( Script_Buffer^[J] ) +
UpCase( Script_Buffer^[J+1] );
L := Script_Buffer^[J+2];
Script_Buffer_Pos := J + 2;
FOR J := 1 TO L DO
BEGIN
Script_Buffer_Pos := Script_Buffer_Pos + 1;
Param_Str := Param_Str +
CHR( Script_Buffer^[Script_Buffer_Pos] );
END;
Writelne( 'Set parameter ' + PName + ' to ' + Param_Str , TRUE );
(* Search for parameter *)
I := 0;
REPEAT
I := I + 1;
UNTIL ( I > Max_Param_Names ) OR ( PName = Param_Names[I] );
(* If found, convert to numeric if *)
(* appropriate *)
IF I <= Max_Param_Names THEN
BEGIN
Param_Num := I;
FOR I := 1 TO LENGTH( Param_Str ) DO
IF Param_Str[I] IN ['0'..'9'] THEN
Param_Ival := Param_Ival * 10 + ORD( Param_Str[I] ) -
ORD( '0' );
IF ( LENGTH( Param_Str ) > 0 ) THEN
IF ( UpCase( Param_Str[1] ) = 'Y' ) THEN
Param_Ival := 1;
Param_Rval := Param_Ival;
END;
END
ELSE
BEGIN
Get_Config_File_Line_From_Script := FALSE;
Script_Buffer_Pos := Script_Buffer_Pos - 1;
END;
END (* Get_Config_File_Line_From_Script *);
(*--------------------------------------------------------------------------*)
BEGIN (* Read_Config_From_Script *)
(* Point to 'Paramsy' entry *)
Script_Buffer_Pos := Script_Buffer_Pos - 1;
(* Pick up all 'Paramsy' entries *)
WHILE( Get_Config_File_Line_From_Script( Param_Num, Param_Str, Param_Ival,
Param_Rval ) ) DO
Set_Parameter( Param_Num, Param_Ival, Param_Rval, Param_Str );
END (* Read_Config_From_Script *);
(*----------------------------------------------------------------------*)
(* Get_Other_Files --- read initialization files *)
(*----------------------------------------------------------------------*)
OVERLAY PROCEDURE Get_Other_Files;
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Get_Other_Files *)
(* *)
(* Purpose: Reads other initialization files than primary config. *)
(* file PIBTERM.CNF. *)
(* *)
(* Calling Sequence: *)
(* *)
(* Get_Other_Files; *)
(* *)
(* Calls: *)
(* *)
(*----------------------------------------------------------------------*)
VAR
I : INTEGER;
(*----------------------------------------------------------------------*)
(* Read_Prefix_File --- Read dialing prefix file *)
(*----------------------------------------------------------------------*)
PROCEDURE Read_Prefix_File;
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Read_Prefix_File *)
(* *)
(* Purpose: Reads dialing prefix file *)
(* *)
(* Calling Sequence: *)
(* *)
(* Read_Prefix_File; *)
(* *)
(* Calls: Read_Config_File *)
(* Read_Prefix_File *)
(* Read_Phone_Directory *)
(* *)
(*----------------------------------------------------------------------*)
VAR
Iprefix : INTEGER;
OK_To_Read : BOOLEAN;
OK_Qmodem : BOOLEAN;
BEGIN (* Read_Prefix_File *)
(* Clear out prefix entries *)
FOR Iprefix := 1 TO Max_Phone_Prefixes DO
Phone_Prefix_Nos[Iprefix] := '';
(* Assign phone prefix file *)
ASSIGN( Phone_Prefix_File , Home_Dir + 'PIBTERM.PRE' );
(*$I-*)
RESET( Phone_Prefix_File );
(*$I+*)
OK_To_Read := ( Int24Result = 0 );
OK_Qmodem := FALSE;
IF NOT OK_To_Read THEN
BEGIN
(* KLUDGE to ensure white text *)
TextColor( White );
IF YesNo('Can''t find PIBTERM.PRE. Try using QMODEM.PRE? ') THEN
BEGIN
ASSIGN( Phone_Prefix_File , 'QMODEM.PRE' );
(*$I-*)
RESET ( Phone_Prefix_File );
(*$I+*)
OK_Qmodem := ( IOResult = 0 );
IF NOT OK_Qmodem THEN
BEGIN
WRITELN;
WRITELN('Can''t find QMODEM.PRE either, no prefixes set.');
END;
END;
END;
(* Read prefix entries *)
IF ( OK_To_Read OR Ok_Qmodem ) THEN
BEGIN
WRITE('Reading phone prefixes from ');
IF Ok_Qmodem THEN
WRITELN('QMODEM.PRE')
ELSE
WRITELN('PIBTERM.PRE');
Iprefix := 1;
REPEAT
READLN( Phone_Prefix_File , Phone_Prefix_Nos[ Iprefix ] );
Iprefix := Iprefix + 1;
UNTIL( EOF( Phone_Prefix_File ) OR ( Iprefix > Max_Phone_Prefixes ) );
(*$I-*)
CLOSE( Phone_Prefix_File );
(*$I+*)
END;
(* Write new prefix file *)
IF NOT Ok_To_Read THEN
BEGIN
ASSIGN( Phone_Prefix_File , Home_Dir + 'PIBTERM.PRE' );
(*$I-*)
REWRITE( Phone_Prefix_File );
(*$I+*)
IF Int24Result <> 0 THEN
BEGIN
WRITELN;
WRITELN('Can''t create new PIBTERM.PRE')
END
ELSE
BEGIN
WRITELN;
WRITELN('Creating PIBTERM.PRE -- phone prefix file.');
FOR Iprefix := 1 TO Max_Phone_Prefixes DO
WRITELN( Phone_Prefix_File , Phone_Prefix_Nos[ Iprefix ] );
CLOSE( Phone_Prefix_File );
END;
END;
END (* Read_Prefix_File *);
(*----------------------------------------------------------------------*)
(* Read_Phone_Directory --- Read phone number directory *)
(*----------------------------------------------------------------------*)
PROCEDURE Read_Phone_Directory;
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Read_Phone_Directory *)
(* *)
(* Purpose: Read phone directory entries *)
(* *)
(* Calling Sequence: *)
(* *)
(* Read_Phone_Directory; *)
(* *)
(* Calls: Read_Config_File *)
(* Read_Prefix_File *)
(* Read_Phone_Directory *)
(* *)
(*----------------------------------------------------------------------*)
TYPE
(* Parity type in Qmodem *)
Check_Bit = ( None, Even );
(* QMODEM phone directory file format *)
Qmodem_Record = RECORD
Name: STRING[25];
Number: STRING[14];
Speed: INTEGER;
Dbits: INTEGER;
Sbits: INTEGER;
Parity: Check_Bit;
END;
(* PC-Talk phone directory file format *)
PCTalk_Record = RECORD
Name: ARRAY[ 1 .. 24 ] OF CHAR;
Filler1: ARRAY[ 1 .. 22 ] OF CHAR;
Number: ARRAY[ 1 .. 14 ] OF CHAR;
Filler2: ARRAY[ 1 .. 2 ] OF CHAR;
Speed: ARRAY[ 1 .. 4 ] OF CHAR;
Parity: CHAR;
Dbits: CHAR;
Sbits: CHAR;
Filler3: ARRAY[ 1 .. 59 ] OF CHAR;
End;
VAR
Iphone : INTEGER;
OK_To_Read : BOOLEAN;
CRLF : Char_2;
T_String : AnyStr;
(* QMODEM phone directory file *)
QmodemF : FILE OF Qmodem_Record;
(* Entry for QMODEM directory file *)
Qmodem_Entry : Qmodem_Record;
(* PC TALK phone directory file *)
PCTalkF : FILE OF PCTalk_Record;
(* Entry for PC Talk directory file *)
PCTalk_Entry : PCTalk_Record;
(*----------------------------------------------------------------------*)
(* Convert_Qmodem_Directory --- Read Qmodem phone number directory *)
(*----------------------------------------------------------------------*)
FUNCTION Convert_Qmodem_Directory : BOOLEAN;
BEGIN (* Convert_Qmodem_Directory *)
Convert_Qmodem_Directory := FALSE;
ASSIGN( QmodemF , 'QMODEM.FON' );
(*$I-*)
RESET ( QmodemF );
(*$I+*)
OK_To_Read := ( IOResult = 0 );
IF NOT OK_To_Read THEN
BEGIN
WRITELN;
WRITELN('Can''t find QMODEM.FON.');
END
ELSE
BEGIN (* Try converting Qmodem dir. to PibTerm dir. *)
ASSIGN( Phone_File , Home_Dir + 'PIBTERM.FON' );
(*$I-*)
REWRITE( Phone_File );
(*$I+*)
IF Int24Result <> 0 THEN
WRITELN('Can''t create new PIBTERM.FON from QMODEM.FON')
ELSE
BEGIN (* Convert QMODEM directory to PibTerm dir. *)
WRITELN;
WRITELN('Converting QMODEM.FON to PIBTERM.FON');
Phone_Entry_Data.Phone_Ender := CRLF;
WITH Phone_Entry_Data, Qmodem_Entry DO
REPEAT
READ( QmodemF , Qmodem_Entry );
CopyStoA( Name , Phone_Name , 25 );
CopyS2AR( Number , Phone_Number , 15 );
STR ( Speed:5 , T_String );
CopyS2AR( T_String , Phone_Baud , 5 );
STR ( Dbits:1 , T_String );
Phone_Databits := T_STRING[1];
STR ( Sbits:1 , T_String );
Phone_StopBits := T_STRING[1];
CASE Parity OF
Even: Phone_Parity := 'E';
None: Phone_Parity := 'N';
Else Phone_Parity := 'O';
END;
WRITE( Phone_File , Phone_Entry_Data );
UNTIL( EOF( QmodemF ) );
CLOSE( Phone_File );
CLOSE( QmodemF );
Convert_Qmodem_Directory := TRUE;
END (* Convert QMODEM phone directory *);
END (* Try Converting QMODEM phone directory *);
END (* Convert_Qmodem_Directory *);
(*----------------------------------------------------------------------*)
(* Convert_PCTalk_Directory --- Read PC TALK phone number directory *)
(*----------------------------------------------------------------------*)
FUNCTION Convert_PCTalk_Directory: BOOLEAN;
BEGIN (* Convert_PCTalk_Directory *)
Convert_PCTalk_Directory := FALSE;
ASSIGN( PCTalkF , 'PCTALK.FON' );
(*$I-*)
RESET ( PCTalkF );
(*$I+*)
OK_To_Read := ( IOResult = 0 );
IF NOT OK_To_Read THEN
BEGIN
WRITELN;
WRITELN('Can''t find PCTALK.FON either, no phone numbers set.');
END
ELSE
BEGIN (* Try converting PC Talk dir. to PibTerm dir. *)
ASSIGN( Phone_File , Home_Dir + 'PIBTERM.FON' );
(*$I-*)
REWRITE( Phone_File );
(*$I+*)
IF Int24Result <> 0 THEN
WRITELN('Can''t create new PIBTERM.FON from PCTALK.FON')
ELSE
BEGIN (* Convert PCTALK directory to PibTerm dir. *)
WRITELN;
WRITELN('Converting PCTALK.FON to PIBTERM.FON');
Phone_Entry_Data.Phone_Ender := CRLF;
WITH Phone_Entry_Data, PCTalk_Entry DO
REPEAT
READ( PCTalkF , PCTalk_Entry );
CopyStoA( Name , Phone_Name , 25 );
CopyS2AR( Number , Phone_Number , 15 );
CopyS2AR( Speed , Phone_Baud , 5 );
Phone_Databits := Dbits;
Phone_StopBits := Sbits;
Phone_Parity := Parity;
WRITE( Phone_File , Phone_Entry_Data );
UNTIL( EOF( PCTalkF ) );
CLOSE( Phone_File );
CLOSE( PCTalkF );
Convert_PCTalk_Directory := TRUE;
END (* Convert PCTalk phone directory *);
END (* Try Converting PCTalk phone directory *);
END (* Convert_PCTalk_Directory *);
(*----------------------------------------------------------------------*)
BEGIN (* Read_Phone_Directory *)
(* Set CR+LF -- ends each phone rec *)
CRLF[1] := CHR( CR );
CRLF[2] := CHR( LF );
(* Assign phone number file *)
ASSIGN( Phone_File , Home_Dir + 'PIBTERM.FON' );
(*$I-*)
RESET( Phone_File );
(*$I+*)
OK_To_Read := ( Int24Result = 0 );
(* Lengthen short dialing directory *)
IF OK_To_Read THEN
BEGIN
IF FileSize( Phone_File ) < ( Default_Phone_Number_Size - 1 ) THEN
BEGIN
WITH Phone_Entry_Data DO
BEGIN
CopyStoA( Dupl( '-' , 25 ) , Phone_Name , 25 );
CopyStoA( ' # ### ###-####' , Phone_Number , 15 );
Phone_Parity := COPY( Parity, 1, 1 );
STR ( Baud_Rate:5 , T_String );
CopyStoA( T_String , Phone_Baud , 5 );
STR ( Data_Bits:1 , T_String );
Phone_Databits := T_STRING[1];
STR ( Stop_Bits:1 , T_String );
Phone_StopBits := T_STRING[1];
Phone_Ender := CRLF;
END;
SEEK( Phone_File, FileSize( Phone_File ) );
FOR Iphone := FileSize( Phone_File ) TO Default_Phone_Number_Size DO
WRITE( Phone_File , Phone_Entry_Data );
CLOSE( Phone_File );
END;
EXIT;
END;
(* Couldn't read directory *)
IF NOT OK_To_Read THEN
BEGIN
(* KLUDGE to ensure white text *)
TextColor( White );
IF YesNo('Can''t find PIBTERM.FON. Try using QMODEM.FON? ') THEN
OK_To_Read := Convert_Qmodem_Directory;
IF ( NOT OK_To_Read ) THEN
IF YesNo('Try using PCTALK.FON? ') THEN
OK_To_Read := Convert_PCTalk_Directory;
END;
(* Create phone directory if needed *)
IF ( NOT OK_To_Read ) THEN
BEGIN (* Phone directory doesn't exist *)
ASSIGN( Phone_File , Home_Dir + 'PIBTERM.FON' );
(*$I-*)
REWRITE( Phone_File );
(*$I+*)
IF Int24Result <> 0 THEN
BEGIN
WRITELN;
WRITELN('Can''t create new PIBTERM.FON')
END
ELSE
BEGIN (* Create phone directory *)
WRITELN;
WRITELN('Creating PIBTERM.FON -- phone number file.');
WITH Phone_Entry_Data DO
BEGIN
CopyStoA( Dupl( '-' , 25 ) , Phone_Name , 25 );
CopyStoA( ' # ### ###-####' , Phone_Number , 15 );
Phone_Parity := COPY( Parity, 1, 1 );
STR ( Baud_Rate:5 , T_String );
CopyStoA( T_String , Phone_Baud , 5 );
STR ( Data_Bits:1 , T_String );
Phone_Databits := T_STRING[1];
STR ( Stop_Bits:1 , T_String );
Phone_StopBits := T_STRING[1];
Phone_ENDer := CRLF;
END;
FOR Iphone := 1 TO Default_Phone_Number_Size DO
WRITE( Phone_File , Phone_Entry_Data );
CLOSE( Phone_File );
END (* Create phone directory *);
END (* Phone directory doesn't exist *);
END (* Read_Phone_Directory *);
(*----------------------------------------------------------------------*)
(* Read_Function_Keys --- Read function key definitions *)
(*----------------------------------------------------------------------*)
PROCEDURE Read_Function_Keys;
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Read_Function_Keys *)
(* *)
(* Purpose: Read function key definitions *)
(* *)
(* Calling Sequence: *)
(* *)
(* Read_Function_Keys; *)
(* *)
(* Calls: Read_Config_File *)
(* Read_Prefix_File *)
(* Read_Phone_Directory *)
(* *)
(*----------------------------------------------------------------------*)
VAR
Input_Key_File : Text;
Key_Name : STRING[3];
Key_Text : AnyStr;
Section_No : INTEGER;
Key_Def_Text : AnyStr;
Key_Number : INTEGER;
L_Text : INTEGER;
I : INTEGER;
J : INTEGER;
(*----------------------------------------------------------------------*)
(* Process_Function_Key_Definition --- Process Function Key Definition *)
(*----------------------------------------------------------------------*)
PROCEDURE Process_Key_Definition;
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Process_Key_Definition *)
(* *)
(* Purpose: Process and store key definition string *)
(* *)
(* Calling Sequence: *)
(* *)
(* Process_Key_Definition; *)
(* *)
(* On entry, Key_Text should have the key definition text *)
(* as read from a file. *)
(* *)
(*----------------------------------------------------------------------*)
(* STRUCTURED *) CONST
Keypad_Nos: ARRAY[0..10] OF BYTE
= ( 9, 7, 4, 8, 2, 0, 3, 5, 1, 6, 10 );
BEGIN (* Process_Key_Definition *)
L_Text := LENGTH( Key_Text );
(* Get key name *)
Key_Name := COPY( Key_Text, 1, 2 );
IF Key_Text[3] <> '=' THEN
Key_Name := Key_Name + Key_Text[3];
(* Choose section *)
CASE UpCase( Key_Name[1] ) OF
'F': Section_No := 1;
'S': Section_No := 2;
'C': IF UpCase( Key_Name[2] ) = 'K' THEN
Section_No := 7
ELSE
Section_No := 3;
'A': IF UpCase( Key_Name[2] ) = 'K' THEN
Section_No := 6
ELSE
Section_No := 4;
'K': Section_No := 5;
ELSE
Section_No := 0;
END (* Case *);
(* Key text initially null *)
Key_Def_Text := '';
(* Get key number *)
I := 2;
Key_Number := 0;
WHILE ( I <= L_Text ) AND ( Key_Text[I] <> '=' ) DO
BEGIN
CASE Key_Text[I] OF
'0'..'9': Key_Number := Key_Number * 10 + ORD(Key_Text[I]) - ORD('0');
'.' : Key_Number := 10;
END (* Case *);
I := I + 1;
END;
(* Skip past '=' sign *)
IF Key_Text[I] = '=' THEN I := I + 1;
(* Get key text *)
IF ( L_Text - I + 1 ) > 0 THEN
Key_Def_Text := Read_Ctrls( COPY( Key_Text, I, L_Text - I + 1 ) );
(* Insert key text in function key *)
(* or keypad key. *)
IF Section_No IN [1..4] THEN
BEGIN
IF ( Key_Number > 0 ) AND ( Key_Number < 11 ) THEN
Function_Keys[ Section_No , Key_Number ] := Key_Def_Text;
END
ELSE IF Section_No IN [5..7] THEN
BEGIN
IF ( Key_Number >= 0 ) AND ( Key_Number < 11 ) THEN
Keypad_Keys[ Section_No - 4 , Keypad_Nos[ Key_Number ] ]
:= Key_Def_Text;
END;
END (* Process_Key_Definition *);
(*----------------------------------------------------------------------*)
BEGIN (* Read_Function_Keys *)
(* Attach file with definitions *)
ASSIGN( Input_Key_File , Home_Dir + 'PIBTERM.FNC' );
(*$I-*)
RESET ( Input_Key_File );
(*$I+*)
(* See if openable *)
IF ( Int24Result = 0 ) THEN
BEGIN (* File OK, read definitions *)
WRITELN('Reading key definitions from PIBTERM.FNC');
REPEAT
Key_Text := ' ';
(* Read key definition *)
READLN( Input_Key_File , Key_Text );
(* Process it *)
Process_Key_Definition;
UNTIL( EOF( Input_Key_File ) );
CLOSE( Input_Key_File );
END (* File OK, read definitions *);
END (* Read_Function_Keys *);
(*----------------------------------------------------------------------*)
(* Read_Translate_Table --- Read translate table definitions *)
(*----------------------------------------------------------------------*)
PROCEDURE Read_Translate_Table;
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Read_Translate_Table *)
(* *)
(* Purpose: Read translate table definitions *)
(* *)
(* Calling Sequence: *)
(* *)
(* Read_Translate_Table; *)
(* *)
(* Calls: Read_Config_File *)
(* Read_Prefix_File *)
(* Read_Phone_Directory *)
(* *)
(*----------------------------------------------------------------------*)
VAR
TrTab_File : TEXT;
I : INTEGER;
J : INTEGER;
BEGIN (* Read_Translate_Table *)
ASSIGN( TrTab_File , Home_Dir + 'PIBTERM.TRA' );
(*$I-*)
RESET ( TrTab_File );
(*$I+*)
IF ( Int24Result = 0 ) THEN
BEGIN (* File OK, read definition *)
WRITELN('Reading translate table from PIBTERM.TRA');
REPEAT
(*$I-*)
READLN( TrTab_File , I, J );
(*$I+*)
IF Int24Result = 0 THEN
IF ( I >= 0 ) AND ( I <= 255 ) AND
( J >= 0 ) AND ( J <= 255 ) THEN
TrTab[CHR(I)] := CHR( J );
UNTIL( EOF( TrTab_File ) );
END (* Get definition from file *);
CLOSE( TrTab_File );
END (* Read_Translate_Table *);
(*----------------------------------------------------------------------*)
BEGIN (* Get_Other_Files *)
(* Read dialing prefix file *)
Read_Prefix_File;
(* Read dialing entries *)
Read_Phone_Directory;
(* Read function key definitions *)
Read_Function_Keys;
(* Read translate table definitions*)
Read_Translate_Table;
END (* Get_Other_Files *);
(*----------------------------------------------------------------------*)
(* Set_Params --- Main code body *)
(*----------------------------------------------------------------------*)
BEGIN (* Set_Params *)
(* Don't reset port unless needed *)
Reset_Comm_Port := FALSE;
(* If comm port changes *)
Comm_Port_Changed := FALSE;
(* Remember current colors *)
New_ForeGround_Color := ForeGround_Color;
New_BackGround_Color := BackGround_Color;
New_Menu_Text_Color := Menu_Text_Color;
New_Menu_Frame_Color := Menu_Frame_Color;
(* Remember current text mode *)
New_Text_Mode := Text_Mode;
(* Get parameter values *)
IF First_Time THEN
BEGIN
Set_Defaults;
IF ( NOT Read_Config_File ) THEN
BEGIN
Get_Default_Params( TRUE );
Write_Config_File;
END;
Get_Other_Files;
END
ELSE
IF ( NOT Use_Script ) THEN
Get_Default_Params( FALSE )
ELSE
Read_Config_From_Script;
(* Initialize Comm Variables *)
IF ( First_Time OR Comm_Port_Changed ) THEN
BEGIN
Async_Init;
(* Open Communications Port *)
Set_Params := Async_Open( Comm_Port, Baud_Rate, Parity, Data_Bits,
Stop_Bits );
END
ELSE
BEGIN
(* Not 1st time, same port -- *)
(* reset open port *)
Set_Params := TRUE;
Async_Reset_Port( Comm_Port, Baud_Rate, Parity, Data_Bits,
Stop_Bits );
END;
IF First_Time THEN
BEGIN
(* Clear screen if initial entry *)
ClrScr;
(* Get backscroll buffer if 1st time *)
Review_Buffer_Length := 81 * Max_Review_Length;
IF Review_Buffer_Length > ( MaxBlockAvail - 32000.0 ) THEN
BEGIN
Max_Review_Length := MAX( 0 ,
TRUNC( ( MaxBlockAvail - 32000.0 ) / 81.0 ) );
Review_Buffer_Length := 81 * Max_Review_Length;
END;
Review_On := ( Max_Review_Length > 0 );
IF Review_On THEN
GetMem( Review_Buffer , Review_Buffer_Length );
Review_Head := 0;
Review_Tail := 0;
Review_Line := '';
END;
(* Change text mode, colors *)
IF Text_Mode <> New_Text_Mode THEN
BEGIN
Text_Mode := New_Text_Mode;
TextMode( Text_Mode );
END;
ForeGround_Color := New_ForeGround_Color;
BackGround_Color := New_BackGround_Color;
Menu_Text_Color := New_Menu_Text_Color;
Menu_Frame_Color := New_Menu_Frame_Color;
Set_Global_Colors( ForeGround_Color , BackGround_Color );
END (* Set_Params *);
